home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PD Collection CD 1
/
PD Collection CD 1.iso
/
programer2
/
siod
/
!Siod
/
!RunImage
(
.txt
)
< prev
next >
Wrap
RISC OS BBC BASIC V Source
|
1993-03-15
|
24KB
|
810 lines
>$.TMP.!Sml.!RunImage
Multitasker for !Sml (c) 1992 Robin Watts
bent to do Siod 2.09
screen% 80*32
indir% 1024
windata% 4096
block% 256
code% 10000
menublock% 2048
cblock% 24
ON ERROR MODE MODE:REPORT:PRINT;" at line ";ERL:END
assemble
initialise
getmodevars
conch
closedown
initialise
"Wimp_Initialise",200,&4B534154,"Siod Tasker"
version%,task%
closedown
"Wimp_CloseDown",task%,&4B534154
conch
setup
loadwindows
initmenus
openwindow(mainwh%,
grabcaret
vdu(12)
!ypos=31
launchsiod
closedown%
closealltasks
setup
size%=(!xmax+1)*(!ymax+1)
closedown%=
!caretowned%=0
prompt%=
taskstarted%=
loadwindows
"Wimp_OpenTemplate",,"<Conch$Dir>.Templates"
9%mainwh%=
doloadtemplate(0,"main")
:%infowh%=
doloadtemplate(1,"info")
"Wimp_CloseTemplate"
doloadtemplate(n%,ident$)
whandle%
"Wimp_LoadTemplate",,windata%+n%*2048,indir%+n%*512,indir%+n%*512+512,-1,
ident$+
(0))),0
"Wimp_CreateWindow",,windata%+n%*2048
whandle%
=whandle%
openwindow(wh%,tooldsize%)
!block%=wh%
tooldsize%
"Wimp_GetWindowInfo",,block%
block%!28=-1
"Wimp_OpenWindow",,block%
"Wimp_Poll",%110001,block%
reason%,block%
reason%
redrawwindow
openwindow(!block%,
closealltasks
mouseclicked
keypressed
menuselected
gaincaret
losecaret
17,18,19
block%!16
closealltasks
&400C1
getmodevars
&808C1
childoutput
&808C2
childstarted
&808C3
childdied
redrawwindow
"Wimp_RedrawWindow",,block%
more%
more%<>0
t. !minx%=(block%!28-block%!4+block%!20)
u. !maxx%=(block%!36-block%!4+block%!20)
v0 !miny%=-(block%!40-block%!16+block%!24)
w2 !maxy%=-(block%!32-block%!16+block%!24)
32+1
redraw
"Wimp_GetRectangle",,block%
more%
closealltasks
taskstarted%
block%!20=1
block%!16=&808C0
block%!0=28
block%!12=0
block%!24=4
"Wimp_SendMessage",17,block%,handle%
taskstarted%=
childdied
assemble
pass%=0
P%=code%
[OPT pass%
.screen
EQUD screen%
EQUD 0
.xmax
EQUD 79
.ymax
EQUD 31
.xwinmax
EQUD 79
.xwinmin
EQUD 0
.ywinmax
EQUD 31
.ywinmin
EQUD 0
.xpos
EQUD 0
.ypos
EQUD 0
.vdusupressed
EQUD 0
.followingbytes
EQUD 0
.numbertocome
EQUD 0
.queueaddr
EQUD queue
.queue
EQUD 0
EQUD 0
EQUD 0
EQUD 0
.bytestoignore
EQUD 0
H \ Enter with Vdu Char in vdu
@ \ No exit Conditions
.dovdu
+ STMFD R13!,{R0-R12,R14}
LDRB R0,vdu
( LDR R1,bytestoignore
CMP R1,#0
" BNE ignorebyte
) LDR R1,followingbytes
CMP R1,#0
! BNE following
) CMP R0,#6 :BEQ vduon
' LDR R1,vdusupressed
+ CMP R1,#1 :BEQ ignore0
* CMP R0,#127:BEQ delete
- CMP R0,#32 :BGE printable
+ CMP R0,#0 :BEQ ignore0
8 CMP R0,#1 :
Q R0,#1 :BEQ ignore
+ CMP R0,#2 :BEQ ignore0
+ CMP R0,#3 :BEQ ignore0
+ CMP R0,#4 :BEQ ignore0
+ CMP R0,#5 :BEQ ignore0
- CMP R0,#7 :BEQ printable
- CMP R0,#8 :BEQ backspace
0 CMP R0,#9 :BEQ forwardspace
, CMP R0,#10 :BEQ linefeed
* CMP R0,#11 :BEQ upline
' CMP R0,#12 :BEQ cls
+ CMP R0,#13 :BEQ creturn
+ CMP R0,#14 :BEQ ignore0
+ CMP R0,#15 :BEQ ignore0
+ CMP R0,#16 :BEQ ignore0
8 CMP R0,#17 :
Q R0,#1 :BEQ ignore
8 CMP R0,#18 :
Q R0,#2 :BEQ ignore
8 CMP R0,#19 :
Q R0,#5 :BEQ ignore
+ CMP R0,#20 :BEQ ignore0
* CMP R0,#21 :BEQ vduoff
8 CMP R0,#22 :
Q R0,#1 :BEQ ignore
8 CMP R0,#23 :
Q R0,#9 :BEQ ignore
8 CMP R0,#24 :
Q R0,#8 :BEQ ignore
8 CMP R0,#25 :
Q R0,#5 :BEQ ignore
) CMP R0,#26 :BEQ vdu26
+ CMP R0,#27 :BEQ ignore0
. CMP R0,#28 :BEQ textwindow
8 CMP R0,#29 :
Q R0,#4 :BEQ ignore
( CMP R0,#30 :BEQ home
' CMP R0,#31 :BEQ tab
.ignore0
* LDMFD R13!,{R0-R12,PC}
.vduon
MOV R0,#0
' STR R0,vdusupressed
B ignore0
.delete
3 MOV R0,#8 :STR R0,vdu:BL dovdu
3 MOV R0,#32 :STR R0,vdu:BL dovdu
3 MOV R0,#8 :STR R0,vdu:BL dovdu
LDR R1,xpos
LDR R2,ypos
" BL changedbox
B ignore0
.backspace
LDR R0,xpos
LDR R1,ypos
" LDR R2,xwinmin
" LDR R3,ywinmin
" LDR R4,xwinmax
" LDR R5,ywinmax
SUB R0,R0,#1
STR R0,xpos
CMP R0,R2
BGE ignore0
MOV R0,R4
STR R0,xpos
SUB R1,R1,#1
STR R1,ypos
CMP R1,R3
BGE ignore0
) BL scrolldownoneline
MOV R1,R3
STR R1,ypos
B ignore0
.forwardspace
LDR R0,xpos
LDR R1,ypos
" LDR R2,xwinmin
" LDR R3,ywinmin
" LDR R4,xwinmax
" LDR R5,ywinmax
ADD R0,R0,#1
STR R0,xpos
CMP R0,R4
BLE ignore0
MOV R0,R2
STR R0,xpos
ADD R1,R1,#1
STR R1,ypos
CMP R1,R5
BLE ignore0
' BL scrolluponeline
MOV R1,R5
STR R1,ypos
B ignore0
.linefeed
MOV R0,#13
STR R0,vdu
BL dovdu
LDR R0,xpos
LDR R1,ypos
$" LDR R2,xwinmin
%" LDR R3,ywinmin
&" LDR R4,xwinmax
'" LDR R5,ywinmax
( ADD R1,R1,#1
STR R1,ypos
CMP R1,R5
BLE ignore0
,' BL scrolluponeline
MOV R1,R5
STR R1,ypos
B ignore0
.upline
LDR R0,xpos
LDR R1,ypos
3" LDR R2,xwinmin
4" LDR R3,ywinmin
5" LDR R4,xwinmax
6" LDR R5,ywinmax
7 SUB R1,R1,#1
STR R1,ypos
CMP R1,R3
BGE ignore0
;) BL scrolldownoneline
MOV R1,R3
STR R1,ypos
B ignore0
@" LDR R1,xwinmax
A" LDR R2,ywinmax
B! BL changedbox
MOV R4,R1
MOV R5,R2
E" LDR R1,xwinmin
F" LDR R2,ywinmin
G! BL changedbox
MOV R3,R2
MOV R2,R1
LDR R6,xmax
K ADD R6,R6,#1
L! LDR R8,screen
MOV R9,#&20
MOV R1,R3
.clslp1
MOV R0,R2
.clslp2
R# MLA R7,R1,R6,R8
S ADD R7,R7,R0
T STRB R9,[R7]
U ADD R0,R0,#1
CMP R0,R4
BLE clslp2
X ADD R1,R1,#1
CMP R1,R5
BLE clslp1
STR R2,xpos
STR R3,ypos
B ignore0
.creturn
_" LDR R0,xwinmin
STR R0,xpos
B ignore0
.vduoff
MOV R0,#1
d' STR R0,vdusupressed
B ignore0
.vdu26
MOV R0,#0
h" STR R0,xwinmin
i" STR R0,ywinmin
STR R0,xpos
STR R0,ypos
LDR R0,xmax
m" STR R0,xwinmax
LDR R0,ymax
o" STR R0,ywinmax
B ignore0
.textwindow
MOV R0,#28
s) STR R0,followingbytes
MOV R0,#4
u' STR R0,numbertocome
B ignore0
.textwindow2
x# LDRB R0,queue+3
y# LDRB R1,queue+2
z# LDRB R2,queue+1
{! LDRB R3,queue
LDR R4,xmax
LDR R5,ymax
CMP R0,R2
BGT ignore0
CMP R1,R3
BLT ignore0
CMP R2,R4
BGT ignore0
CMP R3,R5
BGT ignore0
" STR R0,xwinmin
" STR R1,ywinmax
" STR R2,xwinmax
" STR R3,xwinmin
B ignore0
.home
" LDR R0,xwinmin
STR R0,xpos
" LDR R1,ywinmin
STR R2,ypos
B ignore0
MOV R0,#31
) STR R0,followingbytes
MOV R0,#2
' STR R0,numbertocome
B ignore0
.tab2
# LDRB R0,queue+1
! LDRB R1,queue
" LDR R2,xwinmin
" LDR R3,ywinmin
" LDR R4,xwinmax
" LDR R5,ywinmax
ADD R0,R0,R2
ADD R1,R1,R3
CMP R0,R4
BGT ignore0
CMP R1,R5
BGT ignore0
STR R0,xpos
STR R1,ypos
B ignore0
.ignore
( STR R0,bytestoignore
B ignore0
.ignorebyte
SUB R0,R0,#1
( STR R0,bytestoignore
B ignore0
.following
' LDR R2,numbertocome
$ LDR R3,queueaddr
! SUBS R2,R2,#1
# STRB R0,[R3,R2]
' STR R2,numbertocome
BGE ignore0
/ CMP R1,#28 :BEQ textwindow2
( CMP R1,#31 :BEQ tab2
B ignore0
.printable
! LDR R5,screen
LDR R1,xpos
LDR R2,ypos
! BL changedbox
LDR R4,xmax
ADD R4,R4,#1
# MLA R5,R4,R2,R5
# STRB R0,[R5,R1]
" B forwardspace
.scrolldownoneline
+ STMFD R13!,{R0-R12,R14}
" LDR R1,xwinmax
" LDR R2,ywinmax
! BL changedbox
MOV R3,R2
" LDR R1,xwinmin
" LDR R2,ywinmin
! BL changedbox
MOV R0,R1
MOV R1,R2
" LDR R2,xwinmax
CMP R1,R3
& BEQ blankfirstline
! LDR R4,screen
LDR R7,xmax
ADD R7,R7,#1
SUB R8,R3,#1
.sdollp1
MOV R9,R0
.sdollp2
# MLA R6,R7,R8,R4
# LDRB R5,[R6,R9]
ADD R6,R6,R7
# STRB R5,[R6,R9]
ADD R9,R9,#1
CMP R9,R7
BLE sdollp2
SUB R8,R8,#1
CMP R8,R1
BGE sdollp1
.blankfirstline
# MLA R6,R7,R1,R4
MOV R9,R0
MOV R5,#32
.sdollp3
# STRB R5,[R6,R9]
ADD R9,R9,#1
CMP R9,R2
BLE sdollp3
* LDMFD R13!,{R0-R12,PC}
.scrolluponeline
+ STMFD R13!,{R0-R12,R14}
BL scrollbox
" LDR R2,xwinmax
" LDR R3,ywinmax
" LDR R0,xwinmin
" LDR R1,ywinmin
CMP R1,R3
% BEQ blanklastline
! LDR R4,screen
LDR R7,xmax
ADD R7,R7,#1
ADD R8,R1,#1
.suollp1
MOV R9,R0
.suollp2
# MLA R6,R7,R8,R4
# LDRB R5,[R6,R9]
SUB R6,R6,R7
# STRB R5,[R6,R9]
ADD R9,R9,#1
CMP R9,R7
BLE suollp2
ADD R8,R8,#1
CMP R8,R3
BLE suollp1
.blanklastline
# MLA R6,R7,R3,R4
MOV R9,R0
MOV R5,#32
.suollp3
# STRB R5,[R6,R9]
ADD R9,R9,#1
CMP R9,R2
BLE suollp3
* LDMFD R13!,{R0-R12,PC}
.changedbox
+ STMFD R13!,{R0-R12,R14}
# LDR R0,changed%
CMP R0,#0
& BNE changedalready
& STR R1,changeminx%
& STR R1,changemaxx%
& STR R2,changeminy%
& STR R2,changemaxy%
MOV R1,#1
# STR R1,changed%
* LDMFD R13!,{R0-R12,PC}
.changedalready
& LDR R0,changeminx%
2 CMP R1,R0:STRLT R1,changeminx%
& LDR R0,changemaxx%
2 CMP R1,R0:STRGT R1,changemaxx%
& LDR R0,changeminy%
!2 CMP R2,R0:STRLT R2,changeminy%
"& LDR R0,changemaxy%
#2 CMP R2,R0:STRGT R2,changemaxy%
$* LDMFD R13!,{R0-R12,PC}
.scrollbox
&+ STMFD R13!,{R0-R12,R14}
'# LDR R0,changed%
CMP R0,#0
)+ BLNE changebeforescroll
*$ LDR R0,scrolled%
CMP R0,#0
, BNE scrolled
-" LDR R0,xwinmin
.& STR R0,scrollminx%
/" LDR R0,xwinmax
0& STR R0,scrollmaxx%
1" LDR R0,ywinmin
2& STR R0,scrollminy%
3" LDR R0,ywinmax
4& STR R0,scrollmaxy%
MOV R0,#1
6' STR R0,scrollcount%
7$ STR R0,scrolled%
8* LDMFD R13!,{R0-R12,PC}
.scrolled
:" LDR R0,xwinmin
;& LDR R1,scrollminx%
<. CMP R0,R1:BNE scrollnewwin
=" LDR R0,ywinmin
>& LDR R1,scrollminy%
?. CMP R0,R1:BNE scrollnewwin
@" LDR R0,xwinmax
A& LDR R1,scrollmaxx%
B. CMP R0,R1:BNE scrollnewwin
C" LDR R0,ywinmax
D& LDR R1,scrollmaxy%
E. CMP R0,R1:BNE scrollnewwin
F' LDR R0,scrollcount%
G ADD R0,R0,#1
H' STR R0,scrollcount%
I* LDMFD R13!,{R0-R12,PC}
.scrollnewwin
K" LDR R0,xwinmin
L& LDR R1,changeminx%
M2 CMP R0,R1:STRLT R0,changeminx%
N" LDR R0,xwinmax
O& LDR R1,changemaxx%
P2 CMP R0,R1:STRGT R0,changemaxx%
Q" LDR R0,ywinmin
R& LDR R1,changeminy%
S2 CMP R0,R1:STRLT R0,changeminy%
T" LDR R0,ywinmax
U& LDR R1,changemaxy%
V2 CMP R0,R1:STRGT R0,changemaxy%
W. MOV R0,#0:STR R0,scrolled%
X- MOV R0,#1:STR R0,changed%
Y* LDMFD R13!,{R0-R12,PC}
.changebeforescroll
[+ STMFD R13!,{R0-R12,R14}
\& LDR R0,changeminy%
] SUB R0,R0,#1
^& STR R0,changeminy%
_* LDMFD R13!,{R0-R12,PC}
.scrolled%
EQUD 0
.scrollminx%
EQUD 0
.scrollminy%
EQUD 0
.scrollmaxx%
EQUD 0
.scrollmaxy%
EQUD 0
.scrollcount%
EQUD 0
.changed%
EQUD 0
.changeminx%
EQUD 0
.changeminy%
EQUD 0
.changemaxx%
EQUD 0
.changemaxy%
EQUD 0
.caretowned%
EQUD 0
.block
EQUD block%
.xpix%
EQUD 0
.ypix%
EQUD 0
.minx%
EQUD 0
.miny%
EQUD 0
.maxx%
EQUD 0
.maxy%
EQUD 0
.double%
EQUD 0
.redraw
+ STMFD R13!,{R0-R12,R14}
LDR R3,miny%
) CMP R3,#0:MOVLT R3,#0
LDR R4,maxy%
LDR R5,ymax
) CMP R4,R5:MOVGT R4,R5
LDR R5,minx%
) CMP R5,#0:MOVLT R5,#0
LDR R6,maxx%
LDR R12,xmax
" ADD R12,R12,#1
+ CMP R6,R12:MOVGT R6,R12
MOV R7,#16
MOV R8,#32
LDR R9,block
" LDR R11,screen
.redrawlp1
MOV R0,#4
# LDR R10,[R9,#4]
# LDR R1,[R9,#20]
! SUB R1,R10,R1
# MLA R1,R5,R7,R1
$ LDR R10,[R9,#24]
$ MLA R2,R3,R8,R10
$ LDR R10,[R9,#16]
! SUB R2,R10,R2
! SWI "OS_Plot"
MOV R14,R5
% MLA R1,R3,R12,R11
.redrawlp2
$ LDRB R0,[R1,R14]
# SWI "OS_WriteC"
" ADD R14,R14,#1
CMP R14,R6
! BLE redrawlp2
ADD R3,R3,#1
CMP R3,R4
! BLE redrawlp1
* LDMFD R13!,{R0-R12,PC}
getmodevars
!block%=0
block%!4=4
block%!8=5
block%!12=-1
"OS_ReadVduVariables",block%,block%+40
xeig%=block%!44
yeig%=block%!48
!xpix%=1<<xeig%
!ypix%=1<<yeig%
"!double%=((block%!40)
32)>>5
grabcaret
"Wimp_SetCaretPosition",mainwh%,-1,!xpos*8*!xpix%,-(!ypos+1)*32,32,0
!caretowned%=1
gaincaret
losecaret
mouseclicked
button%
button%=block%!8
(button%
4)=4
grabcaret
(button%
2)=2
popupmenu
popdownmenu
keypressed
char%
char%=block%!24
!block%=mainwh%
char%=(char%
255)
block%!20=1
block%!16=&808C0
block%!0=28
block%!12=0
block%!24=char%
"Wimp_SendMessage",17,block%,handle%
"Wimp_ProcessKey",block%!24
"Wimp_ProcessKey",block%!24
launchsiod
taskwindow("<Siod$Dir>.!Siod209 -i<Scm$Dir>.siod_scm -h20000")
taskwindow(str$)
command$
{command$="TaskWindow """+str$+""" -quit -wimpslot 640K -name ""Siod Engine"" -task &"+
~(task%)+" -txt &00000000 -ctrl"
"Wimp_StartTask",command$
childstarted
handle%=block%!4
inputto%=block%!20
taskstarted%=
childoutput
dovduat(block%+20)
dovduat(addr%)
"Wimp_GetCaretPosition",,cblock%
!cblock%=mainwh%
!caretowned%=1
!caretowned%=0
!changed%=0
!scrolled%=0
l%=0
(!addr%)-1
!vdu=l%?(addr%+4)
dovdu
!scrolled%>0
!caretowned%
"Wimp_SetCaretPosition",mainwh%,-1,-100,-100,32,0
"Wimp_BlockCopy",mainwh%,!scrollminx%*16,-(!scrollmaxy%+1)*32,(!scrollmaxx%+1)*16,-!scrollminy%*32+!ypix%-!scrollcount%*32,!scrollminx%*16,-(!scrollmaxy%+1)*32+!scrollcount%*32
"Wimp_ForceRedraw",mainwh%,!scrollminx%*16,-(!scrollmaxy%+1)*32,(!scrollmaxx%+1)*16,-(!scrollmaxy%+1)*32+!scrollcount%*32
!caretowned%
"Wimp_SetCaretPosition",mainwh%,-1,!xpos*8*!xpix%,-(!ypos+1)*32,32,0
!changed%>0
"Wimp_ForceRedraw",mainwh%,!changeminx%*16,-(!changemaxy%+1)*32,(!changemaxx%+1)*16,-!changeminy%*32+!ypix%
!caretowned%
!scrolled%
"Wimp_SetCaretPosition",mainwh%,-1,!xpos*8*!xpix%,-(!ypos+1)*32,32,0
vdu(n%)
!changed%=0
!vdu=n%
dovdu
!changed%>0
"Wimp_ForceRedraw",mainwh%,!changeminx%*8*!xpix%,-(!changemaxy%+1)*(8<<!double%)*!ypix%,(!changemaxx%+1)*8*!xpix%,-!changeminy%*(8<<!double%)*!ypix%+!ypix%
childdied
"Wimp_GetCaretPosition",,cblock%
!cblock%=mainwh%
"Wimp_SetCaretPosition",-1
closedown%=
initmenus
menuendptr%=menublock%+64
makemenu("Siod|Info|Quit",menuendptr%,0,menublock%)
attachwindow(infowh%,0,0)
makemenu(str$,
ptr%,no%,menublock%)
str1$,off%
str$+="|"
menublock%!(no%<<2)=ptr%
str1$=
slice(str$)
$ptr%=str1$
8+ptr%?12=7:ptr%?13=2:ptr%?14=7:ptr%?15=0
ptr%!16=12*16
ptr%!20=44
ptr%!24=0
off%=28
str1$=
slice(str$)
ptr%!off%=0
str$=""
ptr%!off%=ptr%!off%
(1<<7)
ptr%!(off%+4)=-1
B- ptr%!(off%+8)=&10021 + (7<<24) + (0<<28)
str1$,1)
str1$=
str1$,2)
F# ptr%!off%=ptr%!off%
(1<<2)
G+ ptr%!(off%+8)=ptr%!(off%+8)
(1<<8)
H. ptr%!(off%+12)=
str1$,
str1$,",")-1))
ptr%!(off%+16)=0
J. ptr%!(off%+20)=
str1$,
str1$,",")+1))
$(ptr%+off%+12)=str1$
off%+=24
str$=""
ptr%+=off%
attachmenu(submenu%,item%,parentmenu%)
ptr%
U$ptr%=menublock%!(parentmenu%<<2)
V/ptr%!(32+item%*24)=menublock%!(submenu%<<2)
attachwindow(window%,item%,parentmenu%)
ptr%
[$ptr%=menublock%!(parentmenu%<<2)
ptr%!(32+item%*24)=window%
slice(
str$)
return$
return$=
str$,
str$,"|")-1)
str$=
str$,
str$,"|")+1)
=return$
popupmenu
"Wimp_CreateMenu",,menublock%+64,(block%!0)-64,(block%!4)
popdownmenu
"Wimp_CreateMenu",,-1
menuselected
block%!0
closealltasks